home *** CD-ROM | disk | FTP | other *** search
/ Precision Software Appli…tions Silver Collection 4 / Precision Software Applications Silver Collection Volume 4 (1993).iso / new / clipboot.arj / FLISTER.PRG < prev    next >
Text File  |  1993-05-04  |  14KB  |  434 lines
  1. /*┌──────────────────────────────────────────────────────────────────────┐
  2.  ▌│ Program Name: FLISTER.PRG       Copyright: Gallagher Computing Corp. │
  3.  ▌│     Language: Clipper 5.2          Author: Kevin S Gallagher         │
  4.  ▌├──────────────────────────────────────────────────────────────────────┤
  5.  ▌│ Comments:                                                            │
  6.  ▌│ q_path    - path pointing to QBoot.dat                               │
  7.  ▌├──────────────────────────────────────────────────────────────────────┤
  8.  ▌│ History:                                                             │
  9.  ▌│ Added ability to check several paths for QBoot.dat files - KSG 5/93  │
  10.  ▌└──────────────────────────────────────────────────────────────────────┘
  11.  ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀           */
  12.  
  13. #include "include1.h"
  14. #define MANY_PATHS
  15. static aQboot_:={}, aShow_:={}, q_path := "C:\"
  16. static q_nHandle, a_nHandle, c_nHandle
  17.  
  18. function main
  19.     local cBuf:="", cPassName:="", xx := 0
  20.     @0,0 say Padr(" Reading from "+q_path+Q_FILE+"....",80) color HICOLOR
  21.     UseQbootDat(.t.)
  22.     while !ft_feof()
  23.         cBuf := ft_freadln()
  24.         if isdigit( cBuf )
  25.             if subs( cBuf,1,1 ) != "2"
  26.                 aadd( aQboot_, { rtrim( subs(cBuf,2) ), NIL, "" } )
  27.                 ft_fskip(1)
  28.                 cBuf := ft_freadln()
  29.                 atail( aQboot_ )[3] := rtrim( cBuf )
  30.                 ft_fskip(-1)
  31.             endif
  32.         endif
  33.         ft_fskip()
  34.     enddo
  35.     UseQbootDat(.f.)
  36.     aeval( asort( aQboot_ , , , blocks_ )  ,{ | a | aadd( aShow_, a[1] ) } )
  37.  
  38.     if getargc() == 1
  39.         cPassName := UPPER( getargv(1) )
  40.         if ( xx:=ascan( aShow_,  cPassName ) ) <> 0
  41.             @0,0 say padr(" Swaping files for cPassName",80) color ENCHCOLOR
  42.             WriteBoot( xx )
  43.             inkey(1)
  44.             ft_reboot(1)
  45.         else
  46.             cls
  47.             QOut("PseudoName " + cPassName + " not found in QBoot.dat")
  48.             break
  49.         endif
  50.     endif
  51.  
  52.     MainScrn()
  53.     setcolor(MENUCOLOR)
  54.     #ifdef DO_CLOCK
  55.     //───── running clock displayed on main menu
  56.     //───── recommend ampm() used from ampm.prg and not from clipper.lib
  57.     CM1(8,30,18,49,,,,,{ || devpos(0,69), devout( ampm(time() ),MENUCOLOR) })
  58.     #else
  59.     //───── default to no clock
  60.     CM1(8,30,18,49)
  61.     #endif
  62. return nil
  63.  
  64. function CM1(nTr, nTc, nBr, nBc, aItems_, cColors, aLogic, nBoxType, bBlock)
  65.     local nLen, nHolder, nKey, nSubs, nNewRec := 0, nRequest, nActually
  66.     local cBoxType, cOldColor :="",  cSeek := []
  67.     local oldcur:= setcursor(0)
  68.     local oBrow, oCols
  69.     local aEdit_:={}
  70.     local xx    := 0
  71.     local xxx
  72.     cOldColor   := setcolor( if( ISCHAR( cColors ), cColors , MENUCOLOR  ) )
  73.     nLen        := len(aShow_)
  74.     bBlock      := IF( bBlock == NIL, { || .F. }, bBlock )
  75.  
  76.     if ValType(aLogic) != "A"
  77.         aLogic  := Array(nLen)
  78.         AFill( aLogic, .T. )
  79.     endif
  80.  
  81.     dispbox( nTr-1, nTc-1, nBr, nBc+1, B_DOUBLE+" ", MENUCOLOR )
  82.     ft_shadow(nTr-1, nTc-1, nBr, nBc+1 )
  83.     oBrow:= TBrowseNew( nTr, nTc, nBr-1, nBc )
  84.     oBrow:colorSpec := cColors
  85.     nSubs:= 1
  86.     oBrow:goTopBlock    := { || nSubs := 1 }
  87.     oBrow:goBottomBlock := { || nSubs := nLen }
  88.     oBrow:skipBlock := {| nRequest | nActually := if(abs(nRequest) >= ;
  89.                            if(nRequest >= 0,;
  90.                               nLen - nSubs, nSubs - 1),;
  91.                                  if(nRequest >= 0, nLen - nSubs,;
  92.                                     1 - nSubs),nRequest),;
  93.                                        nSubs += nActually, ;
  94.                                           nActually;
  95.     }
  96.     oCols:=TBColumnNew(, { || aShow_[nSubs]})
  97.     oCols:colorBlock:=   { || if(aLogic[nSubs], { 1, 2 }, { 1, 3 } ) }
  98.     oCols:width     := SHORTY
  99.     oBrow:addColumn(oCols)
  100.  
  101.     while .t.
  102.         oBrow:ForceStable()
  103.         @maxrow(),0 say padc( SHOW_INFO ,80) color DISPCOLOR
  104.         while ( ( nKey := WaitKeys( 0.1 ) ) == 0 )
  105.             eval(bBlock)
  106.         enddo
  107.         @maxrow(),0 say padc( SHOW_INFO ,80) color DISPCOLOR
  108.     
  109.         do case
  110.             //───── let the fingers do the walking...
  111.             case nKey > 32 .and. nKey < 255
  112.                 if ( xxx := AScanner( aShow_, chr( nKey ) ) ) > 0
  113.                     if nSubs > xxx
  114.                         for xx := 1 to nSubs - xxx
  115.                             oBrow:up()
  116.                         next
  117.                     elseif nSubs != xxx
  118.                         nSubs:= xxx
  119.                         oBrow:refreshall()
  120.                         oBrow:ForceStable()
  121.                     endif
  122.                 endif
  123.             case nKey == K_DOWN .or. nKey == K_LEFT
  124.                 if nSubs == nLen
  125.                     oBrow:gotop()
  126.                 else
  127.                     oBrow:down()
  128.                 endif
  129.             case nKey == K_UP .or. nKey == K_RIGHT
  130.                 if nSubs == 1
  131.                     oBrow:gobottom()
  132.                 else
  133.                     oBrow:up()
  134.                 endif
  135.             case nKey == K_PGDN .or. nKey == K_END
  136.                 oBrow:pagedown()
  137.             case nKey == K_PGUP .or. nKey == K_HOME
  138.                 oBrow:pageup()
  139.             case nKey == K_CTRL_PGUP
  140.                 oBrow:gotop()
  141.             case nKey == K_CTRL_PGDN
  142.                 oBrow:gobottom()
  143.             case nKey == K_INS
  144.                 //───── add a new configuration
  145.                 aEdit_ := Editor( {"","","",""} )
  146.                     nNewRec:=SaveEdits( aEdit_ )
  147.                     aadd( aQboot_,{ subs(aEdit_[3],2), NIL ,aEdit_[4] } )
  148.                     aadd( aShow_ ,subs(aEdit_[3],2) )
  149.                     aadd( aLogic ,.t. )
  150.                     asort( aShow_ )
  151.                     asort( aQboot_, , ,blocks_ )
  152.                     nLen := len( aShow_ )
  153.                     oBrow:refreshall()
  154.             case nKey == K_DEL
  155.                 //─────  purge highlighted configuration
  156.                 removeAlias( nSubs )
  157.                 AKill( aQboot_, nSubs )
  158.                 AKill( aShow_ , nSubs )
  159.                 AKill( aLogic , nSubs )
  160.                 nLen := len( aShow_ )
  161.                 // asize( aLogic, nLen )
  162.                 oBrow:gotop()
  163.             case nKey == K_ENTER
  164.                 //───── edit highlighted configuration
  165.                 aEdit_ := GetAliasBuf(nSubs)
  166.                 aEdit_ := editor( aEdit_ )
  167.                 if !empty( aEdit_[1] )
  168.                     removeAlias(nSubs)
  169.                     nNewRec :=SaveEdits( aEdit_ )
  170.                     aShow_[ nSubs ]    := subs( aEdit_[3], 2 )
  171.                     aQboot_[ nSubs,1 ] := subs( aEdit_[3], 2 )
  172.                     aQboot_[ nSubs,2 ] := NIL
  173.                     aQboot_[ nSubs,3 ] := aEdit_[4]
  174.                     asort( aShow_ )
  175.                     asort( aQboot_, , ,blocks_ )
  176.                     oBrow:refreshcurrent()
  177.                     oBrow:gotop()
  178.                 endif
  179.             case nKey == K_F10
  180.                 //───── Swap/boot with new setup if user says so!
  181.                 #ifdef MR_GRUMP
  182.                 if YES_NO("Confirm reboot")
  183.                     WriteBoot( nSubs )
  184.                     inkey(1)
  185.                     ft_reboot(1)
  186.                 endif
  187.                 #else
  188.                 if alert("Confirm reboot", { " Yes ", " No " } ) == 1
  189.                     WriteBoot( nSubs )
  190.                     inkey(1)
  191.                     ft_reboot()
  192.                 endif
  193.                 #endif
  194.             case nKey == K_F3
  195.                 //───── environment editor
  196.                 EnvEditor()
  197.             case nKey == K_ESC
  198.                 ExitToDos()
  199.         endcase
  200.     enddo
  201.     setcolor( cOldColor )
  202.     setcursor( oldcur )
  203. return nSubs
  204.  
  205. /*
  206. * Function..: UseQbootDat() --> Nil
  207. * Purpose...: Open qboot.dat -or- to close qboot.dat
  208. * Returns...: Nil
  209. * Comment...: 
  210. */
  211. function UseQbootDat(lMethod)
  212.     lMethod := if(valtype(lMethod) == "L",lMethod,.F.)
  213.     if lMethod
  214.         q_nHandle := ft_fselect( 0 )
  215.         ft_fuse( q_path + Q_FILE,FO_READWRITE )
  216.     else
  217.         ft_fuse()
  218.     endif
  219. return nil
  220.  
  221. /*
  222. * Function..: removeAlias() --> Nil
  223. * Purpose...: remove a single configuration from QBoot.dat
  224. * Returns...: nil
  225. * Comment...: revised method of getting to proper alias -KSG 5/03/93
  226. */
  227. function removeAlias( nEle )
  228.     local nHandle := 0, cBuf := ""
  229.     if len( aShow_ ) == 1
  230.         nHandle := fcreate( q_path+Q_FILE )
  231.         if !fclose(nHandle)
  232.             @0,0 say "File close error..." color ERRCOLOR
  233.             break
  234.         endif
  235.         return nil 
  236.     endif
  237.  
  238.     FindAlias( nEle )
  239.  
  240.     ft_fdelete()
  241.     while .t.
  242.         do case
  243.             case ( ft_feof() )
  244.                 ft_fdelete(4)
  245.                 ft_fskip(1)
  246.                 ft_fdelete(1)
  247.                 exit
  248.             case ( subs( ft_freadln(), 1, 1 ) ) == "1"
  249.                 //───── we hit another configuration
  250.                 exit
  251.         endcase
  252.         ft_fdelete()
  253.     enddo
  254.     UseQbootDat(.f.)
  255. return nil
  256.  
  257. /*
  258. * Function..: GetAliasBuf( nEle ) --> Nil
  259. * Purpose...: retreive highlighted configuration
  260. * Returns...: array[4]
  261. * Comment...: revised method of getting to proper alias -KSG 5/03/93
  262. */
  263. function GetAliasBuf( nEle )
  264.     local cBuf_ := {"","","","",0}, cTempStr := ""
  265.     FindAlias( nEle )
  266.     cBuf_[ PSEUDO_NAME ] := ft_freadln()
  267.     ft_fskip()
  268.     cBuf_[ LONG_DESC ]   := ft_freadln()
  269.     ft_fskip()
  270.     cTempStr             := ft_freadln()
  271.     cBuf_[1] += cTempStr + NEW_LINE
  272.     ft_fskip()
  273.     while .t.
  274.         cTempStr := ft_freadln()
  275.         if substr(cTempStr,1,1) == "2"
  276.             ft_fskip()
  277.             exit
  278.         endif
  279.         cBuf_[1] += cTempStr + NEW_LINE
  280.         ft_fskip()
  281.     enddo
  282.  
  283.     while .t.
  284.         //───── loop until either EOF or next configuration
  285.         do case
  286.             case ( ft_feof() )
  287.                 exit
  288.             case ( subs( ft_freadln(), 1, 1 ) ) == "1"
  289.                 exit
  290.         endcase
  291.         cBuf_[2] += ft_freadln() + NEW_LINE
  292.         ft_fskip()
  293.     enddo
  294.     UseQbootDat(.f.)
  295. return cBuf_
  296.  
  297. /*
  298. * Function..: FindAlias( <array ele pointer> ) -->nil
  299. * Purpose...: Locates highlighted alias for various routines
  300. * Returns...: Nil
  301. * Comment...: None
  302. */
  303. function FindAlias( nEle )
  304.     UseQbootDat(.t.)
  305.     ft_fgotop()
  306.     while .t.
  307.         if rtrim( SUBS(ft_freadln(),2) ) == aQboot_[nEle][1]
  308.             exit
  309.         endif
  310.         ft_fskip()
  311.     enddo
  312. return nil
  313.  
  314. /*
  315. * Function..: SaveEdits( array[5] ) --> Nil
  316. * Purpose...: Writes edited configuration to the EOF of bootfile
  317. * Returns...: could add logic for filesize, then return logical value..
  318. * Comment...: None
  319. */
  320. function SaveEdits( aChanges_ )
  321.     local nRec := 0
  322.     UseQbootDat(.t.)
  323.     ft_fgobot()
  324.     nRec := ft_frecno()
  325.     ft_fwriteln( aChanges_[ PSEUDO_NAME ] + NEW_LINE + ;
  326.                  aChanges_[ LONG_DESC ]   + NEW_LINE + ;
  327.                  aChanges_[ 1 ]           +            ;
  328.                  "2"          + NEW_LINE  +            ;
  329.                  aChanges_[ 2 ] ,  .f.    ;
  330.     )
  331.     UseQbootDat(.f.)
  332. return nRec
  333.  
  334. /*
  335. * Function..: WriteBoot( nLineNumber ) --> nil
  336. * Purpose...: Write new autoexec.bat - config.sys
  337. * Returns...: Nil
  338. * Comment...: None
  339. */
  340. function WriteBoot( nele )
  341.     local cBuf:=""
  342.     AutoRemake()
  343.     UseQbootDat(.t.)
  344.     FindAlias( nEle )
  345.     a_nHandle := ft_fselect( 0 )
  346.     ft_fuse( AUTOFILE,FO_READWRITE)
  347.     while .t.
  348.         ft_fselect( q_nHandle )
  349.         cBuf := ft_freadln()
  350.         if substr( cBuf,1,1) == "2"
  351.             ft_fskip()
  352.             exit
  353.         endif
  354.         ft_fselect( a_nHandle )
  355.         ft_fappend()
  356.         ft_fwriteln( cBuf,.t.)
  357.         ft_fselect( q_nHandle )
  358.         ft_fskip()
  359.     enddo
  360.     ft_fselect( a_nHandle )
  361.     ft_fuse()
  362.     ConfigRemake()
  363.     c_nHandle := ft_fselect( 0 )
  364.     ft_fuse( CONFFILE, FO_READWRITE )
  365.     while .t.
  366.         ft_fselect( q_nHandle )
  367.         cBuf := ft_freadln()
  368.         if subs( cBuf,1,1) == "1" .or. ft_feof()
  369.             exit
  370.         endif
  371.         ft_fselect( c_nhandle )
  372.         ft_fappend()
  373.         ft_fwriteln( cBuf,.t.)
  374.         ft_fselect( q_nHandle )
  375.         ft_fskip()
  376.     enddo
  377.     ft_fselect( q_nHandle )
  378.     ft_fuse()
  379.     ft_fselect( c_nhandle )
  380.     ft_fuse()
  381. return nil
  382.  
  383. INIT procedure CheckFIle
  384.     local cBuf1 :="", cBuf2:="", nHandle:=0
  385.     #ifdef MANY_PATHS
  386.     local cFullName:= getargv(0)
  387.     #endif
  388.     set(_SET_SCOREBOARD,.F.)
  389.     #ifdef MANY_PATHS
  390.     if file( subs( cFullName,1, rat("\",cFullName )) + Q_FILE )
  391.         q_path := subs( cFullName,1, rat("\",cFullName ))
  392.     elseif file(gete("QBOOT")+Q_FILE)
  393.         q_path := gete("QBOOT")
  394.     endif
  395.     #endif
  396.     if !file( q_path+Q_FILE )
  397.         @0,0 say replicate(" ",80)
  398.         @0,0 say q_path+Q_FILE+" not found, create it [Y/N] "
  399.         if GetYN()
  400.             if file("c:\autoexec.bat") .and. file("c:\autoexec.bat")
  401.                 cBuf1 := memoread("c:\autoexec.bat")
  402.                 cBuf2 := memoread("c:\config.sys")
  403.                 if ( nHandle := fcreate( Q_FILE ,0) ) = -1
  404.                     ?"Error creating config data file"
  405.                     BREAK
  406.                 endif
  407.                 //───── write generic headers
  408.                 fwrite( nHandle, "1CURRENT" + NEW_LINE )
  409.                 fwrite( nHandle, "PLACE A COMMENT HERE" + NEW_LINE )
  410.                 //───── write current autoexec/config files
  411.                 fwrite( nHandle, cBuf1 )
  412.                 fwrite( nHandle, "2" + NEW_LINE )
  413.                 fwrite( nHandle, cBuf2 )
  414.                 fclose( nHandle )
  415.             endif
  416.         else
  417.             break
  418.         endif
  419.     endif
  420. RETURN
  421.  
  422. /***************************************************************************
  423. *
  424. * Default CA-Clipper stuff.
  425. * Warplink v2.6, utility SP.EXE will not run with the following code.
  426. *
  427. */
  428. ANNOUNCE rddsys
  429.  
  430. init procedure rddinit()
  431. return
  432.  
  433.  
  434.